home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Games Collection 1 / software vault.zip / software vault / CDR10 / SPX20.ZIP / SPX_DEMO.ZIP / DEMO02.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-24  |  4KB  |  164 lines
  1. Program Demo2;
  2.  
  3. { SPX library - Sprite demo  Copyright 1993 Scott D. Ramsay  }
  4.  
  5. Uses crt,spx_vga,spx_key,spx_obj,spx_img,spx_tim,spx_txt,spx_fnc;
  6.  
  7. const
  8.   path = '';
  9.   max  = 10;
  10.   framerate  : integer = 20;    { NOT in fps! }
  11.  
  12. type
  13.   Pballs = ^Tballs;
  14.   Tballs = object(Tobjs)
  15.              width,height,              { dimension of sprite }
  16.              kind,                      { sprite number }
  17.              ox,oy,                     { old position }
  18.              x,y,                       { new position }
  19.              dx,dy : integer;           { direction }
  20.              constructor init(nx,ny,k:integer);
  21.              procedure drawitemobject;virtual;
  22.              procedure eraseitemobject;virtual;
  23.              procedure updateitemobject;virtual;
  24.              procedure calcitemobject;virtual;
  25.            end;
  26.  
  27. var
  28.   balls : array[0..2] of pointer;
  29.   pal   : RGBlist;
  30.   head,
  31.   tail  : plist;
  32.  
  33. procedure setup;
  34. var
  35.   p : plist;
  36.   d : integer;
  37. begin
  38.   openmode(3);
  39.   randomize;
  40.   setpageactive(3);
  41.   loadpcx(path+'tank.pcx');
  42.   loadvsp(path+'balls.vsp',balls);
  43.   loadcolors(path+'balls.pal',pal,256);
  44.   head := nil; tail := nil;
  45.   for d := 1 to max do
  46.     begin
  47.       new(p);
  48.       p^.item := new(Pballs,init(random(320),random(200),d mod 3));
  49.       p^.item^.powner := p;
  50.       addp(head,tail,p);
  51.     end;
  52.   fsetcolors(zdc);  { all black palette }
  53.   pcopy(3,2);       { copy to work page }
  54.   pcopy(3,1);       { copy to visual }
  55.   fadein(40,pal);
  56. end;
  57.  
  58.  
  59. procedure placespeed(mode:objmode);
  60. begin
  61.   case mode of
  62.     dDraw   : putletter(4,4,255,st(framerate));
  63.     dErase  : CopyRect(4,4,50,11,pages[3]^,pages[2]^);
  64.     dUpdate : CopyRect(4,4,50,11,pages[2]^,pages[1]^);
  65.   end;
  66. end;
  67.  
  68.  
  69. procedure animate;
  70. var
  71.   p : pointer;
  72. begin
  73.   setpageactive(2);
  74.   setrate(1000);
  75.   repeat
  76.     f_clk[0] := framerate;
  77.     if plus and (framerate<60)
  78.       then inc(framerate)
  79.       else
  80.         if minus and (framerate>0)
  81.           then dec(framerate);
  82.     doallitems(head,dErase);
  83.     placespeed(dErase);
  84.     if not space
  85.       then doallitems(head,dCalc);
  86.     doallitems(head,dDraw);
  87.     placespeed(dDraw);
  88.     doallitems(head,dUpdate);
  89.     placespeed(dUpdate);
  90.     repeat until (f_clk[0]=0);
  91.   until esc;
  92. end;
  93.  
  94. (**) { Tballs methods }
  95.  
  96. constructor Tballs.init(nx,ny,k:integer);
  97. begin
  98.   Tobjs.init;
  99.   kind := k;
  100.   x := nx; y := ny; 
  101.   ox := x; oy := y;
  102.   repeat
  103.     dx := random(7)-3;
  104.     dy := random(7)-3;
  105.   until (dx<>0) and (dy<>0);
  106.   imagedims(balls[kind]^,width,height);
  107. end;
  108.  
  109.  
  110. procedure Tballs.eraseitemobject;
  111. begin
  112.   CopyRect(ox-width shr 1,oy-height shr 1,ox+width shr 1,oy+height shr 1,pages[3]^,pages[2]^);
  113.   CopyRect(x-width shr 1,y-height shr 1,x+width shr 1,y+height shr 1,pages[3]^,pages[2]^);
  114. end;
  115.  
  116.  
  117. procedure Tballs.updateitemobject;
  118. begin
  119.   CopyRect(ox-width shr 1,oy-height shr 1,ox+width shr 1,oy+height shr 1,pages[2]^,pages[1]^);
  120.   CopyRect(x-width shr 1,y-height shr 1,x+width shr 1,y+height shr 1,pages[2]^,pages[1]^);
  121. end;
  122.  
  123.  
  124. procedure Tballs.drawitemobject;
  125. begin
  126.   ftput_clip(x,y,balls[kind]^,true);
  127. end;
  128.  
  129.  
  130. procedure Tballs.calcitemobject;
  131. begin
  132.   ox := x; oy := y;
  133.   inc(x,dx); inc(y,dy);
  134.   if (x<0) or (x>319)
  135.     then dx := -dx;
  136.   if (y<0) or (y>199)
  137.     then dy := -dy;
  138. end;
  139.  
  140.  
  141. procedure showit;
  142. begin
  143.    clrscr;
  144.    writeln('SPX library - Sprite demo');
  145.    writeln('Copyright 1993 Scott D. Ramsay');
  146.    writeln;
  147.    writeln('Keys:');
  148.    writeln(' ESC          - quit demo');
  149.    writeln(' +/-          - change frame speed');
  150.    writeln(' SPACE        - pause ');
  151.    writeln;
  152.    write('Press SPACE to continue.');
  153.    clearbuffer;
  154.    repeat until space;
  155. end;
  156.  
  157.  
  158. begin
  159.   showit;
  160.   setup;
  161.   animate;
  162.   clean_plist(head,tail);
  163.   closemode;
  164. end.